home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / v7n21.arc / COPY.PAS < prev    next >
Pascal/Delphi Source File  |  1988-11-14  |  3KB  |  88 lines
  1. PROGRAM Copy;
  2. CONST
  3.   BufSize = 16384;
  4. VAR
  5.   ioCode               : Byte;
  6.   SrcFile, DstFile     : FILE;
  7.   FileNameA, FileNameB : STRING[255];
  8.   Buffer               : ARRAY[1..BufSize] OF Byte;
  9.   RecsRead             : Integer;
  10.   DiskFull             : Boolean;
  11.  
  12.   PROCEDURE SrcFileError(ioCode : Byte);
  13.   BEGIN
  14.     Write(#7, 'I/O result of ', ioCode, ' (decimal) ', #26);
  15.     CASE ioCode OF
  16.       $01 : WriteLn(' Source file not found.');
  17.       $F3 : WriteLn(' Too many files open.');
  18.     ELSE WriteLn(' "Reset" unknown I/O error.');
  19.     END;
  20.   END;
  21.  
  22.   PROCEDURE DstFileError(ioCode : Byte);
  23.   BEGIN
  24.     Write(#7, 'I/O result of ', ioCode, ' (decimal) ', #26);
  25.     CASE ioCode OF
  26.       $F0 : WriteLn(' Disk data area full.');
  27.       $F1 : WriteLn(' Disk directory full.');
  28.       $F3 : WriteLn(' Too many files open.');
  29.     ELSE WriteLn(' "Rewrite" unknown I/O error.');
  30.     END;
  31.   END;
  32.  
  33. BEGIN
  34.   Write('Copy from file : ');
  35.   ReadLn(FileNameA);
  36.   Write('       To file : ');
  37.   ReadLn(FileNameB);
  38.   IF FileNameB <> FileNameA THEN
  39.     BEGIN
  40.       Assign(SrcFile, FileNameA);
  41.       Assign(DstFile, FileNameB);
  42.       {* Note second parameter in "reset" and "rewrite" of UNtyped files. *}
  43.       {$I-} Reset(SrcFile, 1); {$I+}
  44.       ioCode := IOResult;
  45.       IF ioCode <> 0 THEN SrcFileError(ioCode)
  46.       ELSE
  47.         BEGIN
  48.           {$I-} Rewrite(DstFile, 1); {$I+}
  49.           ioCode := IOResult;
  50.           IF ioCode <> 0 THEN DstFileError(ioCode)
  51.           ELSE
  52.             BEGIN
  53.               DiskFull := False;
  54.               WHILE (NOT EoF(SrcFile)) AND (NOT DiskFull) DO
  55.                 BEGIN
  56.                   {* Note fourth parameter in "blockread". *}
  57.                   {$I-}
  58.                   BlockRead(SrcFile, Buffer, BufSize, RecsRead);
  59.                   {$I+}
  60.                   ioCode := IOResult;
  61.                   IF ioCode <> 0 THEN
  62.                     BEGIN
  63.                       SrcFileError(ioCode);
  64.                       DiskFull := True
  65.                     END
  66.                   ELSE
  67.                     BEGIN
  68.                       {$I-}
  69.                       BlockWrite(DstFile, Buffer, RecsRead);
  70.                       {$I+}
  71.                       ioCode := IOResult;
  72.                       IF ioCode <> 0 THEN
  73.                         BEGIN
  74.                           DstFileError(ioCode);
  75.                           DiskFull := True
  76.                         END
  77.                     END
  78.                 END;
  79.               IF NOT DiskFull THEN WriteLn('File copied.')
  80.             END;
  81.           Close(DstFile)
  82.         END;
  83.       Close(SrcFile)
  84.     END
  85.   ELSE WriteLn(#7, 'File can not be copied onto itself.')
  86. END.
  87.  
  88.